home *** CD-ROM | disk | FTP | other *** search
Wrap
-> tmap experiment OPT OSVERSION=39, LARGE, PREPROCESS CONST CWIDTH=320 -> in units of 64 seems best... CONST CHEIGHT=240,SCOFF=8 CONST SCHEIGHT=SCOFF*2+CHEIGHT,SCDEPTH=8 CONST BUFS=CWIDTH*CHEIGHT MODULE '*geom', '*c2p_cpu3blit1', '*texturemapper', '*screenmodereq_db', 'tools/exceptions', 'tools/scrbuffer', 'intuition/screens', 'intuition/intuition', 'graphics/rastport', 'graphics/gfx' PROC addc(p:PTR TO point,c,l,fishy) DEF a,b a,b:=project3d(c,p,CWIDTH/2,CHEIGHT/2,fishy) ListAdd(l,[a,b]) ENDPROC PROC render(cbuf,c:PTR TO opoint,fishy,pic) DEF l[8]:LIST clearmem(cbuf,CWIDTH*CHEIGHT,-1) addc([100,100,0]:point,c,l,fishy) addc([-100,100,0]:point,c,l,fishy) addc([-100,-100,0]:point,c,l,fishy) addc([100,-100,0]:point,c,l,fishy) tmap(l,cbuf,CWIDTH,CHEIGHT,pic,64,64) SetList(l,0) addc([-100,-100,0]:point,c,l,fishy) addc([100,-100,0]:point,c,l,fishy) addc([100,-100,-200]:point,c,l,fishy) addc([-100,-100,-200]:point,c,l,fishy) tmap(l,cbuf,CWIDTH,CHEIGHT,pic,64,64) SetList(l,0) addc([100,-100,0]:point,c,l,fishy) addc([100,100,0]:point,c,l,fishy) addc([100,100,-200]:point,c,l,fishy) addc([100,-100,-200]:point,c,l,fishy) tmap(l,cbuf,CWIDTH,CHEIGHT,pic,64,64) ENDPROC tmaplab: INCBIN 'car64x64x8.iff.cmchunky' PROC clearmem(mem,size,pat) DEF e:REG,a:REG,b:REG,c:REG,d:REG e:=size/16-1 a:=b:=c:=d:=pat MOVE.L mem,A0 ADD.L size,A0 clloop: MOVEM.L a/b/c/d,-(A0) DBRA e,clloop ENDPROC PROC main() HANDLE DEF dbs,scr=NIL:PTR TO screen,bm:PTR TO bitmap,win=NIL:PTR TO window,cam:PTR TO opoint, cbuf,imsg:PTR TO intuimessage,key,frames=0,dframes,fsec,ssec,smic,esec,emic,fishy=60, a,pic,tpic[17000]:ARRAY OF CHAR cam:=[200,-200,150,-45,45,10]:opoint pic:={tmaplab} IF (dbs:=openreqscreen(CWIDTH,SCHEIGHT,SCDEPTH,'bla'))=NIL THEN Raise() -> OpenScreen scr:=sb_GetScreen(dbs) IF (win:=OpenW(0,0,CWIDTH-1,SCHEIGHT-1, IDCMP_MOUSEBUTTONS OR IDCMP_VANILLAKEY, WFLG_BORDERLESS OR WFLG_SIMPLE_REFRESH OR WFLG_BACKDROP OR WFLG_ACTIVATE OR WFLG_RMBTRAP, '',scr,15,NIL))=NIL THEN Raise("WIN") NEW cbuf[BUFS] FOR a:=0 TO 255 DO SetColour(scr,a,pic[]++,pic[]++,pic[]++) FOR a:=0 TO 64 DO CopyMem(a*64+pic,a*256+tpic,64) SetRast(scr.rastport,255) bm:=sb_NextBuffer(dbs) SetRast(scr.rastport,255) c2p_setup(gfxbase,CWIDTH,CHEIGHT,SCOFF,0 /* dummy */,NewM(CWIDTH*CHEIGHT,2)) CurrentTime({ssec},{smic}) REPEAT render(cbuf,cam,fishy,tpic) Colour(0,255) ->TextF(0,SCHEIGHT-5,'x=\d y=\d z=\d turn=\d up=\d tilt=\d, wide=\d',cam.x,cam.y,cam.z,cam.turn,cam.up,cam.tilt,fishy) bm:=sb_NextBuffer(dbs) c2p(cbuf,bm.planes) frames++ IF imsg:=GetMsg(win.userport) IF imsg.class=IDCMP_VANILLAKEY key:=imsg.code SELECT key CASE "n"; cam.turn:=cam.turn+10 -> turnleft CASE "m"; cam.turn:=cam.turn-10 -> turnright CASE "d"; cam.up:=cam.up-10 -> lookdown CASE "c"; cam.up:=cam.up+10 -> lookup CASE "v"; cam.tilt:=cam.tilt-10 -> bankleft CASE "b"; cam.tilt:=cam.tilt+10 -> bankright CASE "s"; cam.z:=cam.z+10 -> down CASE "x"; cam.z:=cam.z-10 -> up CASE "a"; cam.y:=cam.y+10 -> yforward CASE "z"; cam.y:=cam.y-10 -> ybackward CASE "w"; cam.x:=cam.x+10 -> xright CASE "e"; cam.x:=cam.x-10 -> xleft CASE "r"; fishy:=fishy+10 -> zoom CASE "t"; IF fishy>15 THEN fishy:=fishy-10 -> wide angle -> "q" quits ENDSELECT ELSEIF imsg.class=IDCMP_MOUSEBUTTONS ENDIF ReplyMsg(imsg) ENDIF UNTIL key="q" CurrentTime({esec},{emic}) dframes:=Mul(esec-ssec,100)+Div(emic-smic,10000) fsec:=Div(Mul(frames,10000),dframes) IF frames THEN WriteF('calculated \d frames in \d.\z\d[2] seconds, giving \d.\z\d[2] f/s\n',frames,Div(dframes,100),Mod(dframes,100),Div(fsec,100),Mod(fsec,100)) EXCEPT DO IF win THEN CloseWindow(win) closereqscreen(dbs) SELECT exception CASE "SCR"; WriteF('no screen!\n') CASE "REQ"; WriteF('Error: Could not allocate ASL request\n') CASE "ASL"; WriteF('Error: Could not open ASL library\n') ENDSELECT report_exception() ENDPROC